home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr48
/
stsim2.zip
/
MENU.SYS
< prev
next >
Wrap
Text File
|
1993-04-01
|
2KB
|
89 lines
unit menu;
{ *************************
Menu System Revision 1
Print(var s:text)
prints screen;
f(x) Process(var s:text)
process the screen
and return choice
************************* }
interface
procedure print(var s:text);
implementation
procedure print(var s:text);
var
ch:char;
begin
reset(s);
repeat
read(s,ch);
if ch='~' then exit;
write(ch);
until eof(s);
end;
function process(var s:text):string;
var
ch:char;
tmp_string:string;
int_code:string;
procedure input(s:string);
var
i,nchoice:integer;
acc:string;
choice:array[1..100] of string[30];
begin
acc:='';
nchoice:=1;
for i:=1 to length(s) do begin
if s[i]=',' then begin
choice[nchoice]:=acc;
inc(nchoice);
acc:='';
end else
acc:=acc+s[i];
end;
{ ----------match choice---------}
readln(acc);
for i:=1 to nchoice do begin
if acc=choice[i] then
process:=acc;
end;
{---------------------------------}
end;
begin
process:='~(nil)';
reset(s);
int_code:='';
{------read until processing-------}
repeat
read(s,ch);
if ch='~' then begin
int_code:='break';
end;
until eof(s) or (int_code='break');
{----------------------------------}
repeat
read(s,ch);
case ch of
'{': begin
tmp_string:='';
repeat
read(s,ch);
tmp_string:=tmp_string+ch;
until ch='}';
delete(tmp_string,length(tmp_string),1);
tmp_string:=tmp_string+',';
input(tmp_string);
end;
end;
until eof(s);
end;
end.